home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / util / conv / dbf2asc2.lha / DBF2ASC / English / dbf2asc2_UK.bas < prev    next >
BASIC Source File  |  1996-07-29  |  8KB  |  337 lines
  1. REM $STACK
  2. REM $NOEVENT
  3. REM $NOBREAK
  4. REM $NOAUTODIM
  5. REM $NOLINES
  6. REM $NODEBUG
  7. REM $OVERFLOW
  8. REM $ADDICON
  9. REM $ERRORS
  10. REM $INCPATH MB_INCLUDES:BH
  11. REM $LIBPATH MB_INCLUDES:BMAP
  12. REM $NOWINDOW
  13. REM $NOLIBRARY
  14. REM MAXONBASIC3
  15.  
  16. revision$="$VER: MicroBase dBASE-Convert 1.0.4, Rev. 29.07.1996 - ©FR-SW"
  17. WINDOW 5,MID$(revision$,7,29)
  18. DEFINT a - z
  19. CONST TAG_DONE&=0
  20. CONST DBFBUFLEN&=4097
  21. DIM frtags&(20)
  22. DIM q&(4097)
  23. ext$=".DBF"
  24. reverse$=""
  25. accept$=""
  26.  
  27. DECLARE FUNCTION trim$(a$)
  28. DECLARE SUB forminput(fil%,a$)
  29.  
  30. LIBRARY "exec.library"
  31. DECLARE FUNCTION AllocMem&(l&,r&) LIBRARY
  32. DECLARE FUNCTION FreeMem&(b&,l&) LIBRARY
  33. LIBRARY "dos.library"
  34. DECLARE FUNCTION xOpen&(n&,m&) LIBRARY
  35. DECLARE FUNCTION xClose&(fh&) LIBRARY
  36. DECLARE FUNCTION xRead&(fh&,buf&,l&) LIBRARY
  37. DECLARE FUNCTION Seek&(fh&,p&,m&) LIBRARY
  38. REM $include asl.bh
  39. LIBRARY OPEN "exec.library"
  40. LIBRARY OPEN "dos.library"
  41. LIBRARY OPEN "asl.library"
  42.  
  43. dbfansi$=""
  44. RESTORE ibm
  45. FOR i%=0 TO 255
  46.   READ t%
  47.   dbfansi$=dbfansi$+CHR$(t%)
  48. NEXT i%
  49.  
  50. GOSUB aslreq
  51.  
  52. IF back$>""
  53.   fhbuf&=AllocMem&(DBFBUFLEN&,65539&)
  54.   bac$=back$+CHR$(0)
  55.   back&=SADD(bac$)
  56.   fhdos&=xOpen&(back&,1004)
  57.   r&=xRead&(fhdos&,fhbuf&,1)
  58.   dbfvers$=CHR$(PEEK(fhbuf&))
  59.   dbf&=ASC(dbfvers$)
  60.   update$=""
  61.   r&=xRead(fhdos&,fhbuf&,1)
  62.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  63.   r&=xRead(fhdos&,fhbuf&,1)
  64.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  65.   r&=xRead(fhdos&,fhbuf&,1)
  66.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  67.   update$=RIGHT$(update$,2)+"."+MID$(update$,3,2)+"."+LEFT$(update$,2)
  68.   r&=xRead&(fhdos&,fhbuf&,4)
  69.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  70.   GOSUB umdrehen
  71.   reccount&=CVL(reverse$) 
  72.   r&=xRead&(fhdos&,fhbuf&,2)
  73.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  74.   GOSUB umdrehen
  75.   headerlength&=CVI(reverse$)
  76.   r&=xRead&(fhdos&,fhbuf&,2)
  77.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  78.   GOSUB umdrehen
  79.   reclength&=CVI(reverse$)
  80.   fieldcount&=(headerlength&-1)/32-1
  81.   DIM fldnam$(fieldcount&),fldtyp$(fieldcount&),fldadr&(fieldcount&)
  82.   DIM fldlen&(fieldcount&),flddec&(fieldcount&)
  83.   datei$=LEFT$(back$,LEN(back$)-3)+"ASC"
  84.   PRINT "Converting ";back$;" -> ";datei$
  85.   PRINT
  86.   feld&=0
  87.   FOR i&=1 TO fieldcount&
  88.     r&=Seek&(fhdos&,(32*i&),(-1&))
  89.     r&=xRead&(fhdos&,fhbuf&,11&)
  90.     POKE fhbuf&+11,0
  91.     fldnam$=PEEK$(fhbuf&)
  92.     fldnam$(i&)=trim$(fldnam$)
  93.     r&=xRead&(fhdos&,fhbuf&,1&)
  94.     fldtyp$(i&)=CHR$(PEEK(fhbuf&))
  95.     r&=xRead&(fhdos&,fhbuf&,4&)
  96.     reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  97.     GOSUB umdrehen
  98.     fldadr&(i&)=CVL(reverse$)
  99.     r&=xRead&(fhdos&,fhbuf&,1&)
  100.     fldlen&(i&)=PEEK(fhbuf&)
  101.     r&=xRead&(fhdos&,fhbuf&,1&)
  102.     flddec&(i&)=PEEK(fhbuf&)
  103.     IF fldtyp$(i&)="M"
  104.       q&(i&)=0
  105.       PRINT fldnam$(i&);" {";i&;"}: MEMO field (will not be processed)"
  106.     ELSE
  107.       INCR feld&
  108.       q&(i&)=fldlen&(i&)
  109.     END IF
  110.     IF fldtyp$(i&)="D"
  111.       q&(i&)=q&(i&)+2
  112.     END IF
  113.   NEXT i&
  114.   PRINT
  115.   PRINT "Fields: ";fieldcount&;" -> ";feld&
  116.   PRINT
  117.   PRINT "Field delimiter (press <Return> for '";CHR$(34);"'): ";
  118.   anf$="34"
  119.   forminput 3,anf$
  120.   PRINT
  121.   IF anf$=""
  122.     anf$="34"
  123.   END IF
  124.   anf$=CHR$(VAL(anf$))
  125.   WHILE INKEY$<>""
  126.   WEND
  127.   PRINT "Field separator (press <Return> for ','): ";
  128.   trenn$="44"
  129.   forminput 3,trenn$
  130.   PRINT
  131.   IF trenn$=""
  132.     trenn$="44"
  133.   END IF
  134.   trenn$=CHR$(VAL(trenn$))
  135.   PRINT "Save field names, too (Y|N)? ";
  136.   fs$="Y"
  137.   forminput 1,fs$
  138.   PRINT
  139.   OPEN "o",#3,datei$
  140.   trenner = 0
  141.   IF fs$="Y"
  142.       FOR i&=1 TO fieldcount&
  143.           IF (q&(i&)<>0)
  144.             IF (trenner<>0)
  145.               PRINT #3,trenn$;
  146.             END IF
  147.             trenner = 1
  148.             PRINT #3,anf$;fldnam$(i&);anf$;
  149.           END IF
  150.       NEXT i&
  151.       PRINT #3
  152.   END IF
  153.   ic$="Y"
  154.   PRINT "Convert ASCII chars to ANSI (Y|N) ";
  155.   forminput 1,ic$
  156.   PRINT
  157.   IF UCASE$(ic$)="Y"
  158.     ic!=1
  159.   END IF
  160.   PRINT
  161.   aktuell&=0
  162.   FOR i&=1 TO reccount&
  163.     p&=Seek&(fhdos&,headerlength&+reclength&*(i&-1),-1&)
  164.     r&=xRead&(fhdos&,fhbuf&,1&)
  165.     recdel$=CHR$(PEEK(fhbuf&))
  166.     out$=""
  167.     trenner = 0
  168.     FOR t&=1 TO fieldcount&
  169.       r&=xRead&(fhdos&,fhbuf&,fldlen&(t&))
  170.       POKE fhbuf&+fldlen&(t&),0
  171.       a$=PEEK$(fhbuf&)
  172.       d$ = ""
  173.       ft$= fldtyp$(t&)
  174.       IF ft$ = "C"
  175.         IF ic!
  176.           ibm2ansi (a$)
  177.           d$=ibm2ansi$
  178.         ELSE
  179.           d$=a$
  180.         END IF
  181.       END IF
  182.       IF ft$ = "N"
  183.         IF flddec&(t&)=0
  184.           d$=a$
  185.         ELSE
  186.           d$=LEFT$(a$,fldlen&(t&)-flddec&(t&)-1)+"."+MID$(a$,fldlen&(t&)-flddec&(t&)+1)
  187.           IF LEFT$(d$,1)="."
  188.             d$=MID$(d$,2)
  189.           END IF
  190.         END IF
  191.         uix&=INSTR(d$,",")
  192.         IF uix&<>0
  193.           MID$(d$,uix&,1)="."
  194.         END IF
  195.       END IF
  196.       IF ft$ = "D"
  197.         d$=RIGHT$(a$,2)+"."+MID$(a$,5,2)+"."+LEFT$(a$,4)
  198.       END IF
  199.       IF (ft$ <> "M")
  200.         IF trenner
  201.           out$=out$+trenn$
  202.         END IF
  203.         trenner = 1
  204.         out$=out$+anf$+trim$(d$)+anf$
  205.       END IF
  206.     NEXT t&
  207.     IF recdel$<>"*"
  208.       PRINT #3,out$
  209.       INCR aktuell&
  210.     END IF
  211.     PRINT INT(100*i&/reccount&+0.5);" % processed            ";
  212.     LOCATE CSRLIN,1
  213.   NEXT i&
  214.   PRINT
  215.   PRINT
  216.   PRINT reccount&-aktuell&;" deleted records (not processed)"
  217.   PRINT aktuell&;" records processed"
  218.   r&=xClose&(fhdos&)
  219.   r&=FreeMem&(fhbuf&,DBFBUFLEN&)
  220.   PRINT
  221.   PRINT "Completed."
  222. END IF
  223. END
  224.  
  225. umdrehen:
  226.     tvi$=reverse$
  227.     reverse$=""
  228.     FOR tt&=LEN(tvi$) TO 1 STEP -1
  229.       reverse$=reverse$+MID$(tvi$,tt&,1)
  230.     NEXT tt&
  231. RETURN
  232.  
  233. SUB ibm2ansi(tvi$)
  234.     SHARED ibm2ansi$, dbfansi$
  235.     ibm2ansi$=""
  236.     FOR tt&=1 TO LEN(tvi$)
  237.         ft%=ASC(MID$(tvi$,tt&,1))
  238.         tvw$=MID$(dbfansi$,ft%+1,1)
  239.         IF tvw$<>CHR$(1)
  240.           ibm2ansi$=ibm2ansi$+tvw$
  241.         END IF
  242.     NEXT tt&
  243. END SUB
  244.  
  245. aslreq:
  246.     back$=""
  247.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&,"Select a dBASE file", _
  248.             ASLFR_InitialFile&,"", _
  249.             ASLFR_InitialDrawer&, CURDIR$, _
  250.             TAG_DONE&
  251.  
  252.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  253.     IF fr& THEN
  254.         IF AslRequest&(fr&,0) THEN
  255.             aslfile$=PEEK$(PEEKL(fr&+fr_File))
  256.             asldir$=PEEK$(PEEKL(fr&+fr_Drawer))
  257.             IF RIGHT$(asldir$,1)<>":" AND RIGHT$(asldir$,1)<>"/"
  258.               asldir$=asldir$+"/"
  259.             END IF
  260.             back$=asldir$+aslfile$
  261.         END IF
  262.         FreeASlRequest fr&
  263.     END IF
  264. RETURN    
  265.  
  266. FUNCTION trim$(a$)
  267.   trim$=LTRIM$(RTRIM$(a$))
  268. END FUNCTION
  269.  
  270. SUB forminput(fil%,a$)
  271. 'fil%=maximum length, a$=input/output
  272. 'Quit with <Return>, delete input with <ESC>.
  273.   fiz%=CSRLIN
  274.   fis%=POS(0)
  275.   fis$=SPACE$(fil%)
  276.   fip%=1
  277.   fi$=""
  278.   a$=LEFT$(LTRIM$(RTRIM$(a$)),fil%)
  279.   WHILE fi$<>CHR$(13)
  280.     LOCATE fiz%,fis%
  281.     PRINT LEFT$(a$+fis$,fil%);
  282.     LOCATE fiz%,fis%+fip%-1
  283.     COLOR 0,1
  284.     PRINT LEFT$(MID$(a$,fip%,1)+" ",1);
  285.     COLOR 1,0
  286.     fi:
  287.     fi$=INKEY$
  288.     IF fi$="" GOTO fi
  289.     fia%=ASC(fi$)
  290.     SELECT CASE fia%
  291.     CASE 13
  292.     CASE 30
  293.       INCR fip%
  294.     CASE 31
  295.       DECR fip%
  296.     CASE 8
  297.       IF fip%>1
  298.         a$=LEFT$(a$,fip%-2)+MID$(a$,fip%)
  299.         DECR fip%
  300.       END IF
  301.     CASE 27
  302.       a$=""
  303.       fip%=1
  304.     CASE ELSE
  305.       IF ((ASC(fi$) AND 127) > 31)
  306.         a$=LEFT$(a$+fis$,fip%-1)+fi$+MID$(a$,fip%)
  307.       END IF
  308.     END SELECT
  309.     IF fip%<1
  310.       fip%=1
  311.     END IF
  312.     IF fip%>fil%
  313.       fip%=fil%
  314.     END IF
  315.   WEND
  316.   a$=LEFT$(a$,fil%)
  317.   LOCATE fiz%,fis%
  318.   PRINT LEFT$(a$+fis$,fil%);
  319. END SUB
  320.  
  321. ibm:
  322. DATA 1, 1, 1, 1, 1, 1, 1, 183, 176, 1, 1, 1, 1, 1, 1, 45, 1, 1
  323. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 32, 33, 34, 35, 36
  324. DATA 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55
  325. DATA 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74
  326. DATA 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93
  327. DATA 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109
  328. DATA 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124
  329. DATA 125, 126, 1, 199, 252, 233, 226, 228, 224, 229, 231, 234, 235, 232, 239
  330. DATA 238, 236, 196, 197, 201, 230, 198, 244, 246, 242, 251, 249, 255, 214, 220
  331. DATA 162, 163, 165, 1, 1, 225, 237, 243, 250, 241, 209, 170, 186, 191, 1, 172
  332. DATA 189, 188, 161, 171, 187, 1, 1, 1, 124, 1, 1, 1, 1, 1, 1, 1, 1
  333. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  334. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  335. DATA 223, 1, 182, 1, 1, 181, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 177, 1
  336. DATA 1, 1, 1, 1, 1, 176, 183, 183, 1, 1, 178, 183, 32
  337.